home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 August: Tool Chest / Apple_Developer_Group_August_1996_Tool_Chest.iso / Sample Code / Snippets / Printing / InvertedText / InvertedText.Pas next >
Encoding:
Pascal/Delphi Source File  |  1992-07-15  |  30.6 KB  |  886 lines  |  [TEXT/TPAS]
  1. program MyDemo;
  2. {
  3.     purpose         to demonstrate a typical Macintosh application
  4. }
  5.  
  6. {$R-}               { Turn off range checking               }
  7. {$I-}               { Turn off I/O error checking           }
  8. {$B+}               { Set bundle bit (for icon, etc.)       }
  9. {$R MyDemo.Rsrc}    { Identify resource file                }
  10. {$T APPLDM01}       { Set application ID                    }
  11. {$U-}               { Turn off auto link to runtime units   }
  12.  
  13.   uses PasInOut,Memtypes,QuickDraw,OSIntf,ToolIntf,PackIntf,MacPrint;
  14.  
  15. const
  16.   hiliteBit     =     7;    { flag bit in HiliteMode (lowMem flag) }
  17.  
  18.   MenuCnt       =     5;    { total # of menus                   }
  19.   ApplMenu      =  1000;    { resource ID of Apple Menu          }
  20.   EditMenu      =  1001;    { resource ID of Edit Menu           }
  21.   InfoMenu      =  1002;    { resource ID of Info Menu           }
  22.   GrafMenu      =  1003;    { resource ID of Grafics Menu        }
  23.   DiskMenu      =  1004;    { resource ID of Disk Menu           }
  24.   
  25.   AM            =     1;    { index into MenuList for Apple Menu }
  26.   EM            =     2;    { ditto for Edit Menu                }
  27.   IM            =     3;    { ditto for Information Menu         }
  28.   GM            =     4;    { ditto for Grafics Menu             }
  29.   DM            =     5;    { ditto for Disk Menu                }
  30.   
  31.   MainID        =  1000;    { resource ID for MainWindow         }
  32.   AboutID       =  1000;    { resource ID for dialog box         }
  33.   Text1ID       =  1000;    { resource IDs for 'About...' text   }
  34.   Text2ID       =  1001;
  35.   Text3ID       =  1002;
  36.   
  37.   myCursID      =  1000;    { resource ID for myCursor          }
  38.   myCursor      =     5;    { array index for myCursor          }
  39.   
  40.   BSize         =   512;    { buffer size for DiskI/O           }
  41.   BCount        =   256;    { buffer count for Disk I/O         }
  42.  
  43. type
  44.   Buffer           = packed array[1..BSize] of Char;   { used for DiskI/O }
  45.   BufFile       = file of Buffer;                   { ditto }
  46.   CursorList    = array[iBeamCursor..myCursor] of CursHandle;
  47.   PtrInteger    = ^integer;
  48.   PtrString     = ^str255;
  49.   
  50. var
  51.   HiliteMode    : Ptr;
  52.  
  53.   F             : file of Buffer;   { used in I/O routines }
  54.   Finished      : Boolean;             { used to terminate the program }
  55.   Ticks         : Longint;             { keeps track of time }
  56.   TV,TH         : Integer;             { location of text }
  57.   theEvent      : EventRecord;      { event passed from operating system }
  58.  
  59.  
  60.   { Screen stuff}
  61.   DragArea         : Rect;    { defines area where window can be dragged in }
  62.   GrowArea         : Rect;    { defines area to which a window's size can change }
  63.   ScreenArea    : Rect;    { defines screen dimensions }
  64.   CursList      : CursorList;   { used to hold cursor handles }
  65.  
  66.   { Menu stuff}
  67.   MenuList         : array[1..MenuCnt] of MenuHandle;  { holds menu info }
  68.   
  69.   { Window stuff }
  70.   MainPtr          : WindowPtr;        { pointer to main window        }
  71.   MainRec          : WindowRecord;     { holds data for main window    }
  72.   MainPeek      : WindowPeek;       { pointer to MainRec            }
  73.   ScreenPort    : GrafPtr;          { pointer to entire screen      }
  74.   FrontWindow   : WindowPtr;        { pointer to active window      }
  75.  
  76.   { program specific stuff}
  77.   VFlag         : boolean;
  78.   FileSelected  : Boolean;          { if true, file is selected     }
  79.   VolParmBlock  : ParmBlkPtr;
  80.   FileParmBlock : ParmBlkPtr;
  81.   Reply         : SFReply;
  82.   SPtr          : StringPtr;
  83.  
  84.  
  85. procedure ClearWindow(WPtr : WindowPtr);
  86. {
  87.     purpose               clears window, draws grow stuff, sets location
  88. }
  89. var
  90.   TRect            : Rect;
  91. begin
  92.   if (WPtr = MainPtr) and (Wptr = FrontWindow ) then begin
  93.     EraseRect(WPtr^.portRect);            { clear rect area of window   }
  94.     DrawGrowIcon(WPtr);                   { draw grow icon              }
  95.     TH := 5; TV := 12                     { set text loc to upper left  }
  96.   end
  97. end; { of proc ClearWindow }
  98.  
  99. procedure DrawStart(Str : String);
  100. {
  101.     purpose         moves to text location and writes out Str
  102. }
  103. begin
  104.   MoveTo(TH,TV);                        { move to current text location }
  105.   DrawString(Str);                      { write on screen               }
  106.   TH := TH + StringWidth(Str)           { advance location to end of str}
  107. end; { of proc DrawStart }
  108.  
  109. procedure RealToStr(Val : Real; var Str : String);
  110. {
  111.     purpose         does conversion from real number to string
  112.                     can be replaced with RealToString(Val,Digits,Style)
  113. }
  114. var
  115.   Int,Frac      : LongInt;
  116.   TStr          : String;
  117. begin
  118.   Str := '';                                { set string to null        }
  119.   Int := Trunc(Val);                        { get integer portion of val}
  120.   Frac := Round(10.0*(Val-Int));            { get fractional part of val}
  121.   NumToString(Int,Str);                     { convert int to string     }
  122.   NumToString(Frac,TStr);                   { convert fract to string   }
  123.   Str := Str+'.'+TStr                       { put decimal point between }
  124. end; { of proc RealToStr }  
  125.  
  126. procedure DrawEnd(Ticks : Longint);
  127. {
  128.     purpose         finish message with time in seconds
  129. }
  130. var
  131.   Str       : String;
  132. begin
  133.   MoveTo(TH,TV);                            { move to our text location }
  134.   DrawString(' in ');                       { write out string          }
  135.   RealToStr(Ticks/60.0,Str);                { convert ticks to second   }
  136.   Str := Str+' seconds';                    { concat with string        }
  137.   DrawString(Str);                          { and write that out        }
  138.   TV := TV + 12;  TH := 5                   { set to start of next line }
  139. end; { of proc DrawEnd }
  140.  
  141.  
  142.  
  143. {   *********   items in Info Menu   *********** }
  144. PROCEDURE DrawStuff;
  145. VAR
  146.     theString   : Str255;
  147.     theRect     : Rect;
  148.  
  149. BEGIN
  150.     theString := 'This should be white-on-black.';
  151.     SetRect(theRect, 128, 195, 384, 257);
  152.     FillRect(theRect, black);
  153.     TextFace([outline]);
  154.     PenMode(srcBic);
  155.     MoveTo(theRect.left + 10, theRect.top + 20);
  156.     DrawString(theString);
  157.     MoveTo(theRect.left + 10, theRect.top + 40);
  158.     DrawString(theString);
  159. END;
  160.  
  161. PROCEDURE InvertText;
  162. {
  163.     Example of printing inverted text on the LaserWriter.
  164.     6/25/87 ...ZZ
  165. }
  166. VAR
  167.     thePrRec    : THPrint;
  168.     thePrPort   : TPPrPort;
  169.     theStatus   : TPrStatus;
  170.     oldPort     : GrafPtr;
  171.  
  172. BEGIN
  173.     GetPort(oldPort);
  174.     thePrRec := THPrint(NewHandle(SIZEOF(TPrint)));
  175.  
  176.     DrawStuff;
  177.  
  178.     PrOpen;
  179.         PrintDefault(thePrRec);
  180.         IF PrStlDialog(thePrRec) THEN BEGIN
  181.             IF PrJobDialog(thePrRec) THEN BEGIN
  182.                 thePrPort := PrOpenDoc(thePrRec, NIL, NIL);
  183.                 IF PrError = noErr THEN BEGIN
  184.                    PrOpenPage(thePrPort, NIL);
  185.                     IF PrError = noErr THEN BEGIN
  186.                         SetPort(@thePrPort^.gPort);
  187. { Draw things to be printed here. }
  188.                         DrawStuff;
  189.                    END;
  190.                     PrClosePage(thePrPort)
  191.                 END;
  192.             END;
  193.         END;
  194.     PrCloseDoc(thePrPort);
  195.     IF (thePrRec^^.prJob.bJDocLoop = bSpoolLoop) and (PrError = noErr) THEN
  196.         PrPicFile(thePrRec, NIL, NIL, NIL, theStatus);                
  197.     PrClose;
  198.  
  199.     SetPort(oldPort);
  200. END;
  201.  
  202.  
  203. procedure DoSort;
  204. {   
  205.     purpose         does selection sort on list of <Count> strings
  206. }
  207. const
  208.   Count               = 500;
  209. type
  210.   NumStr        = string[7];
  211. var
  212.   List                : array[1..Count] of NumStr;
  213.   S                   : NumStr;
  214.   T                   : String;
  215.   L                   : Longint;
  216.   I,J,Min          : Integer;
  217. begin
  218.   L := 1000000 + Count;                 { set up list in reverse order  }
  219.   for I := 1 to Count do begin          { for each slot in array do     }
  220.     NumToString(L,T);                   {   convert value to string     }
  221.     List[I] := T;                       {   store in array              }
  222.     L := L - 1                          {   decrease value by one       }
  223.   end;
  224.   NumToString(Ord4(Count),T);           { convert Count to string       }
  225.   DrawStart('Sorts '+T+' strings');     { write starting message    }
  226.   Ticks := Tickcount;                   { *** start timing ***          }
  227.   for I := 1 to Count-1 do begin        { I = current top of list       }
  228.     Min := I;                           {  assume List[I] = lowest val  }
  229.     for J := I+1 to Count do            {  look in rest of list         }
  230.       if List[J] < List[Min]            {  if a lower value is found    }
  231.         then Min := J;                  {   then remember where it is   }
  232.     S := List[I];                       {  swap lowest value with top   }
  233.     List[I] := List[Min];
  234.     List[Min] := S
  235.   end;
  236.   DrawEnd(Tickcount-Ticks)              { *** stop timing ***           }
  237. end; { of proc DoSort }
  238.  
  239. procedure DoMacInfo;
  240. {  purpose      display some information about the macintosh  }
  241. var
  242.   CPUFlag         : ptr;
  243.   HWCFgFlags      : ptr;
  244.   RomVersion      : PtrInteger;
  245.   AString         : str255;
  246.   Version         : StringPtr;
  247.   HFSFlag         : PtrInteger;
  248.   RomVersionByte  : ptr;
  249. begin
  250.  
  251.   CPUFlag := Ptr($12F);                     {  CPU flag global          }
  252.   MoveTo(50,100); DrawString('MicroProcessor:  ');
  253.   case CPUFlag^ of
  254.     0 : DrawString('68000');
  255.     1 : DrawString('68010');
  256.     2 : DrawString('68020');
  257.   end;
  258.   
  259.   HWCFgFlags := Ptr($B22);                  {  Hardware Equipment Flag  }
  260.   MoveTo(50,125);
  261.   if (HWCFgFLags^ and $80) = $80 then
  262.     DrawString('MacPlus')
  263.   else
  264.     DrawString('Mac');
  265.     
  266.   RomVersion := PtrInteger($400008);        {  Mac ROM version flag     }
  267.   MoveTo(50,150); DrawString('ROM Version Number:  ');
  268.   if RomVersion^ = $0069 then
  269.     DrawString('Old 64K')
  270.   else
  271.     if RomVersion^ = $70FF then
  272.       DrawString('New XL')
  273.     else
  274.       if RomVersion^ = $0075 Then
  275.       begin
  276.         DrawString('128K ');
  277.         RomVersionByte   := Ptr($400002);   {  It's the New Roms        }
  278.         case RomVersionByte^ of             {  test for which version # }
  279.           $EE : DrawString('V1');
  280.           $F4 : DrawString('V2');
  281.           $EA : DrawString('V3');
  282.         end;       
  283.       end;
  284.   
  285.   HFSFlag := PtrInteger($3F6);              {  HFS file system global   }
  286.   MoveTo(50,175); DrawString('File System:  ');
  287.   if HFSFlag^ > 0 then
  288.     DrawString('HFS')
  289.   else
  290.     DrawString('MFS');
  291. end;
  292.  
  293.  
  294. {   *********   items in Graphics Menu   *********** }
  295.  
  296. procedure DoRectangle;
  297. {
  298.     purpose         draws a lot of rectangles
  299. }
  300. const
  301.   Count         = 100;
  302. var
  303.   R                         : Rect;
  304.   I,RX1,RX2,RY1,RY2   : Integer;
  305.   WindowPort          : GrafPtr;
  306.   AString : str255;
  307. begin
  308.   for I := 1 to Count do          { for Count times do...         }
  309.   begin
  310.     { set bounds of rectangle       }
  311.     GetPort(WindowPort);
  312.     
  313.     RX1 := abs(Random) mod (WindowPort^.portRect.right-15);
  314.     RY1 := abs(Random) mod (WindowPort^.portRect.bottom-15);
  315.     RX2 := abs(Random) mod (WindowPort^.portRect.right-15);
  316.     RY2 := abs(Random) mod (WindowPort^.portRect.bottom-15);
  317.  
  318.     SetRect(R,RX1,RY1,RX2,RY2);
  319.     FrameRect(R);                  {   draw rectangle        }
  320.   end;
  321. end; { of proc DoRectangle }
  322.  
  323. procedure DoCircle;
  324. {
  325.     purpose         draws and then paints over a lot of circles
  326. }
  327. const
  328.   Count         = 100;
  329. var
  330.   R                   : Rect;
  331.   I                   : Integer;
  332.   WindowPort    : grafPtr;
  333.   RX1,RX2,RY1,RY2 : Integer;
  334. begin
  335.   for I := 1 to Count do            { for Count times do...             }
  336.   begin 
  337.     { set bounds of rectangle       }
  338.     GetPort(WindowPort);
  339.     
  340.     RX1 := abs(Random) mod (WindowPort^.portRect.right-15);
  341.     RY1 := abs(Random) mod (WindowPort^.portRect.bottom-15);
  342.     RX2 := abs(Random) mod (WindowPort^.portRect.right-15);
  343.     RY2 := abs(Random) mod (WindowPort^.portRect.bottom-15);
  344.  
  345.     SetRect(R,RX1,RY1,RX2,RY2);
  346.     FrameOval(R);              {   draw a black circle             }
  347.   end;
  348. end; { of proc DoCircle }
  349.  
  350.   
  351. {   *********   items in Disk I/O Menu   *********** }
  352.  
  353.  
  354. procedure DoGetVolInfo;
  355. {  Displays Information about the Default Volume  }
  356. var
  357.   theErr  : OSErr;
  358.   AString : str255;
  359.   Secs    : LongInt;
  360.   DateVar,TimeVar : str255;
  361.  
  362. begin
  363.  
  364.   SPtr^ := '';
  365.   VolParmBlock^.ioNamePtr := SPtr;   { set volume name to default vol    }
  366.   VolParmBlock^.ioCompletion := nil;
  367.   VolParmBlock^.ioVolIndex := 0;
  368.   theErr := PBGetVInfo(VolParmBlock,false);
  369.  
  370.   {  display volume name  }  
  371.   MoveTo(50,75);
  372.   DrawString('Volume Name:');
  373.   MoveTo(200,75);
  374.   DrawString(VolParmBlock^.ioNamePtr^);
  375.   
  376.   {  display date and time of volume creation  }
  377.   Secs := VolParmBlock^.ioVCrDate;
  378.   IUDateString(Secs,abbrevDate,DateVar);
  379.   IUTimeString(Secs,true,TimeVar);
  380.   MoveTo(50,100);
  381.   DrawString('Volume Created:');
  382.   AString := DateVar+'  '+TimeVar;
  383.   MoveTo(200,100);
  384.   DrawString(AString);
  385.     
  386.   {  display date and time of last volume backup  }
  387.   Secs := VolParmBlock^.ioVLsBkUp;
  388.   IUDateString(Secs,abbrevDate,DateVar);
  389.   IUTimeString(Secs,true,TimeVar);
  390.   MoveTo(50,125);
  391.   DrawString('Last Backup:');
  392.   AString := DateVar+'  '+TimeVar;
  393.   MoveTo(200,125);
  394.   DrawString(AString);
  395.  
  396.   {  display number of files in the current volume  }
  397.   {  note:  for HFS volumes this is the number of   }
  398.   {         files in the current folder             }  
  399.   NumToString(VolParmBlock^.ioVNmFls,AString);
  400.   MoveTo(50,150);
  401.   DrawString('Number of Files:');
  402.   MoveTo(200,150);
  403.   DrawString(AString);
  404.   
  405. end;
  406.  
  407.  
  408. procedure DoOpenFile;
  409. {  Brings up Dialog Box and Opens a File  }
  410. var
  411.   topLeft      : Point;
  412.   FileFilter   : SFTypeList;
  413.   theErr       : OSErr;
  414.   AString      : str255;
  415. begin
  416.  
  417.   topLeft.h := 90;             { top left horiz point for Get File dialog }
  418.   topLeft.v := 80;             { top left vert    "    "   "    "    "    }
  419.   FileFilter[0] := 'TEXT';     { file filter for text files               }
  420.   
  421.   SFGetFile(topLeft,'',nil,-1,FileFilter,nil,Reply);
  422.   if Reply.Good then
  423.   begin
  424.     FileSelected := true;
  425.     FileParmBlock^.ioCompletion := nil;
  426.     FileParmBlock^.ioVRefNum := Reply.vRefNum;
  427.     FileParmBlock^.ioNamePtr := @Reply.fName;
  428.     FileParmBlock^.ioVersNum := 0;
  429.     FileParmBlock^.ioPermssn := 0;
  430.     FileParmBlock^.ioMisc := nil;
  431.     
  432.     theErr := PBOpen(FileParmBlock,false);
  433.     VolParmBlock^.ioVRefNum := FileParmBlock^.ioVRefNum;
  434.     VolParmBlock^.ioCompletion := nil;
  435.     SPtr^ := '';
  436.     VolParmBlock^.ioNamePtr := SPtr;   { set volume name to default vol    }
  437.     theErr := PBSetVol(VolParmBlock,false); { update vol ref # }
  438.   end;
  439. end;
  440.  
  441.  
  442. procedure DoGetFileInfo;
  443. {  Displays Information about the Current File  }
  444. var
  445.   theErr   : OSErr;
  446.   DateVar,TimeVar : str255;
  447.   AString : str255;
  448.   Secs   : LongInt;
  449.   
  450. begin
  451.  
  452.   theErr := PBGetFInfo(FileParmBlock, false);    { Get File Information }
  453.   
  454.   {  display file name  }
  455.   MoveTo(50,75);
  456.   DrawString('File Name:');
  457.   MoveTo(200,75);
  458.   DrawString(FileParmBlock^.ioNamePtr^);
  459.   
  460.   {  display date file was created  }
  461.   Secs := FileParmBlock^.ioFlCrDat;
  462.   IUDateString(Secs,abbrevDate,DateVar);
  463.   IUTimeString(Secs,true,TimeVar);
  464.   MoveTo(50,100);
  465.   DrawString('File Created:');
  466.   AString := DateVar+'  '+TimeVar;
  467.   MoveTo(200,100);
  468.   DrawString(AString);
  469.     
  470.   {  display date file was last modified  }
  471.   Secs := FileParmBlock^.ioFlMDDat;
  472.   IUDateString(Secs,abbrevDate,DateVar);
  473.   IUTimeString(Secs,true,TimeVar);
  474.   MoveTo(50,125);
  475.   DrawString('Last Modified:');
  476.   AString := DateVar+'  '+TimeVar;
  477.   MoveTo(200,125);
  478.   DrawString(AString);
  479.  
  480.   {  display length of data fork  }
  481.   MoveTo(50,150);
  482.   DrawString('Size of Data Fork:');
  483.   NumToString(FileParmBlock^.ioFlLgLen,AString);
  484.   MoveTo(200,150);
  485.   DrawString(AString);
  486.   
  487.   {  display length of resource fork  }
  488.   MoveTo(50,175);
  489.   DrawString('Size of Resource Fork:');
  490.   NumToString(FileParmBlock^.ioFlRLgLen,AString);
  491.   MoveTo(200,175);
  492.   DrawString(AString);
  493. end;
  494.  
  495. procedure DoCloseFile;
  496. {  Closes the current File  }
  497. var
  498.   theErr  : OSErr;
  499. begin
  500.   theErr := PBClose(FileParmBlock,false);
  501.   FileSelected := false;
  502. end;
  503.  
  504.  
  505.  
  506. {   *********   items in Apple Menu   *********** }
  507.  
  508. procedure DoAbout;
  509. {
  510.     purpose         bring up 'About...' box using a dialog box
  511. }
  512. var
  513.   theItem       : Integer;    
  514.   AboutPtr      : DialogPtr;
  515.   S1,S2,S3      : StringHandle;
  516. begin 
  517.   SetCursor(CursList[myCursor]^^);      { set to my cursor              }
  518.   ShowCursor;                           { and turn it back on           }
  519.   S1 := GetString(Text1ID);             { get text from resource file   } 
  520.   S2 := GetString(Text2ID);
  521.   S3 := GetString(Text3ID); 
  522.   ParamText(S1^^,S2^^,S3^^,'');         { and set up as parameter text  }
  523.   AboutPtr := getNewDialog(AboutID,NIL,Pointer(-1));    { get dialog box}    
  524.   ModalDialog(NIL,theItem);             { put dialog box up; get result }
  525.   DisposDialog(AboutPtr);               { get rid of dialog box         }
  526.   SetCursor(Arrow)
  527. end; { of proc DoAbout }
  528.  
  529. procedure DoDeskAcc(Item : Integer);
  530. {
  531.     purpose         start up desk accessory from Apple menu
  532. }
  533. var
  534.   SavePort          : GrafPtr;
  535.   RefNum            : Integer;
  536.   DName             : String;
  537. begin
  538.   GetPort(SavePort);                    { save port before starting it  }
  539.   GetItem(MenuList[AM],Item,DName);     { get name of desk accessory    }
  540.   refNum := OpenDeskAcc(DName);         { and start that sucker up!     }
  541.   SetPort(SavePort);                    { restore grafport and continue }
  542. end; { of proc DoDeskAcc }
  543.  
  544. {   *********   event handling routines   *********** }
  545.  
  546. procedure ToggleFlag(var Flag : Boolean; Mndx,Indx : Integer);
  547. {
  548.     purpose         checks or de-checks item Indx in menu Mndx
  549.     last update     20 Aug 86
  550. }
  551. var
  552.   Ch            : Char;
  553. begin
  554.   Flag := not Flag;                     { toggle flag (for you)         }
  555.   if Flag                               { if flag is True...            }
  556.     then Ch := Chr(CheckMark)           {   then check item in menu     }
  557.     else Ch := Chr(NoMark);             {   else clear any checkmark    }
  558.   SetItemMark(MenuList[Mndx],Indx,Ch)   { put char by item in menu      }
  559. end; { of proc ToggleFlag }
  560.  
  561. procedure SetItemState(Mndx,Indx : Integer; Flag : Boolean);
  562. {
  563.     purpose         if true, enables item Indx of menu Mndx; else disables
  564.     last update     22 Aug 86
  565. }
  566. begin
  567.   if Flag
  568.     then EnableItem (MenuList[Mndx],Indx)
  569.     else DisableItem(MenuList[Mndx],Indx)
  570. end; { of proc SetItemState }
  571.  
  572. procedure UpdateMenu;
  573. {
  574.     purpose         enable or disable items in I/O menu as needed
  575. }
  576. begin
  577.   SetItemState(DM,3,FileSelected);                { update file Info }
  578.   SetItemState(DM,4,FileSelected);                {   ditto          }
  579. end; { of proc UpdateMenu }
  580.  
  581. procedure HandleMenu(MenuInfo : LongInt);
  582. {
  583.     purpose         decode MenuInfo and carry out command
  584. }
  585. var
  586.   Menu          : Integer;          { menu number that was selected     }
  587.   Item          : Integer;          { item in menu that was selected    }
  588.   B             : Boolean;          { dummy flag for SystemEdit call    }
  589. begin
  590.   if MenuInfo <> 0 then begin
  591.     ClearWindow(MainPtr);           { we're clearing the window         }
  592.     PenNormal;                      { set the pen back to normal        }
  593.     Menu := HiWord(MenuInfo);       { find which menu the command is in }
  594.     Item := LoWord(MenuInfo);       { get the command number            }
  595.     case Menu of                    { and carry it out                  }
  596.       ApplMenu  : if Item = 1
  597.                     then DoAbout            { bring up "About..." window}
  598.                     else DoDeskAcc(Item);   { start desk accessory      }
  599.       EditMenu  : case Item of              
  600.                1,3..6 : if not SystemEdit(Item-1) { pass to desk acc    }
  601.                            then { do nothing }; 
  602.                     8 : Finished := True;   { Quit command              }    
  603.                   end;
  604.       InfoMenu  : case Item of              { Information Menu          }
  605.                     1 :    InvertText;
  606.                     2 :    DoSort;
  607.                     3 : DoMacInfo;
  608.                   end;
  609.  
  610.       GrafMenu  : case Item of              { Graphics menu             }
  611.                     1 :    DoCircle;
  612.                     2 :    DoRectangle;
  613.                   end;
  614.  
  615.       DiskMenu  :    case Item of              { Disk I/O menu             }
  616.                     1 :    DoGetVolInfo;
  617.                     2 :    DoOpenFile;
  618.                     3 :    DoGetFileInfo;
  619.                     4 : DoCloseFile;
  620.                     6 : ToggleFlag(VFlag,DM,Item);  { toggle check mark }
  621.                   end
  622.     end;{case of Menu}
  623.     HiliteMenu(0);                          { reset menu bar            }
  624.     if Menu = DiskMenu
  625.       then UpdateMenu;                      { make any changes needed   }
  626.   end
  627. end; {of proc HandleMenu}
  628.  
  629. procedure HandleClick(WPtr : WindowPtr; MLoc : Point);
  630. {
  631.     purpose         handle mouse click within window
  632. }
  633. begin       
  634.   if WPtr = MainPtr                         { if this is our window...  }
  635.     then if WPtr <> FrontWindow             { and it's not in front...  }
  636.       then SelectWindow(WPtr)               { ...then make it active    }
  637. end; { of proc HandleClick }
  638.  
  639. procedure HandleGoAway(WPtr : WindowPtr; MLoc : Point);
  640. {
  641.     purpose         handle mouse click in go-away box
  642. }
  643. var
  644.   WPeek             : WindowPeek;           { for looking at windows    }
  645. begin
  646.   if WPtr = FrontWindow then begin          { if it's the active window }
  647.     WPeek := WindowPeek(WPtr);              { peek at the window        }
  648.     if TrackGoAway(WPtr,MLoc) then begin    {   and the box is clicked  } 
  649.       if WPeek^.WindowKind = userKind       {     if it's our window    }   
  650.         then Finished := True               {       then time to stop   }
  651.         else CloseDeskAcc(WPeek^.WindowKind){       else close DeskAcc  }
  652.     end   
  653.   end
  654.   else SelectWindow(WPtr)                   { else make it active       }
  655. end; { of proc HandleGoAway }
  656.  
  657. procedure HandleGrow(WPtr : WindowPtr; MLoc : Point);
  658. {
  659.     purpose         handle mouse click in grow box
  660. }
  661. type
  662.   GrowRec           =
  663.     record
  664.       case Integer of
  665.         0           : (Result       : LongInt);
  666.         1           : (Height,Width : Integer)
  667.     end;
  668. var
  669.   GrowInfo          : GrowRec;
  670. begin
  671.   if WPtr = MainPtr then with GrowInfo do begin { if it's our window    }
  672.     Result := GrowWindow(WPtr,MLoc,GrowArea);   {   get amt of growth   }
  673.     SizeWindow(WPtr,Width,Height,True);         {   resize window       }
  674.     InvalRect(WPtr^.portRect)                   {   set up for update   }
  675.   end
  676. end; { of proc HandleGrow }
  677.  
  678. procedure DoMouseDown(theEvent:EventRecord);
  679. {
  680.     purpose         identify where mouse was clicked and handle it
  681. }
  682. var
  683.   Location      : Integer;
  684.   theWindow     :    WindowPtr;
  685.   MLoc          :    Point;
  686.   WLoc          :    Integer;
  687. begin
  688.   MLoc  := theEvent.Where;              { get mouse position            }
  689.   WLoc := FindWindow(MLoc,theWindow);   { get window, loc in window     }
  690.   case WLoc of                          { handle window locations       }
  691.     InMenuBar   : HandleMenu(MenuSelect(MLoc));     { in the menu       }
  692.     InContent   : HandleClick(theWindow,MLoc);      { inside the window }
  693.     InGoAway    : HandleGoAway(theWindow,MLoc);     { in the go away box}
  694.     InGrow      : HandleGrow(theWindow,MLoc);       { in the grow box   }
  695.     InDrag         : DragWindow(theWindow,MLoc,DragArea); { in the drag bar}
  696.     InSysWindow : SystemClick(theEvent,theWindow)   { in a DA window    }
  697.   end
  698. end; { of proc DoMouseDown }
  699.  
  700. procedure DoKeypress(theEvent : EventRecord);
  701. {
  702.     purpose         handles keypress (keyDown, autoKey) event
  703. }
  704. var
  705.   KeyCh             : Char;
  706. begin
  707.   if (theEvent.modifiers and cmdKey) <> 0 then begin { menu key command }
  708.     KeyCh := Chr(theEvent.Message and charCodeMask); { decode character }
  709.     HandleMenu(MenuKey(KeyCh))                       { get menu and item}
  710.   end
  711.   else SysBeep(1)                                     { do *something*  }
  712. end; { of proc DoKeypress }
  713.  
  714. procedure DoUpdate(theEvent : EventRecord);
  715. {
  716.     purpose         handles window update event
  717. }
  718. var
  719.   SavePort,theWindow    : WindowPtr;
  720. begin
  721.   theWindow := WindowPtr(theEvent.Message);     { find which window     }
  722.   if theWindow = MainPtr then begin             { only update ours      }
  723.     SetCursor(CursList[watchCursor]^^);         { set cursor to watch   }
  724.     GetPort(SavePort);                          { save current grafport }
  725.     SetPort(theWindow);                         { set as current port   }
  726.     BeginUpdate(theWindow);                     { signal start of update}
  727.     
  728.   { and here's the update stuff! }
  729.     ClearWindow(theWindow);                     { do update stuff       }
  730.   { now, back to our program...}
  731.  
  732.     EndUpdate(theWindow);                       { signal end of update  }
  733.     SetPort(SavePort);                          { restore grafport      }
  734.     SetCursor(Arrow)                            { restore cursor        }
  735.   end
  736. end; { of proc DoUpdate }
  737.  
  738. procedure DoActivate(theEvent : EventRecord);
  739. {
  740.     purpose         handles window activation event
  741. }
  742. var
  743.   I         : Integer;
  744.   AFlag     : Boolean;
  745.   theWindow : WindowPtr;
  746. begin
  747.   with theEvent do begin
  748.     theWindow := WindowPtr(Message);            { get the window        }
  749.     AFlag := Odd(Modifiers);                    { get activate/deactive }
  750.     if AFlag then begin                         { if it's activated...  }
  751.       SetPort(theWindow);                       {   make it the port    }
  752.       FrontWindow := theWindow;                 {   know it's in front  }
  753.       DrawGrowIcon(theWindow);                  {   set size box        }
  754.     end
  755.     else begin
  756.       SetPort(ScreenPort);                      { else reassign port    }
  757.       if theWindow = FrontWindow                { if it's in front      }
  758.         then FrontWindow := NIL                 { ...then forget that   }
  759.     end;
  760.     if theWindow = MainPtr then begin           { if it's our window    }
  761.       SetItemState(EM,1,not AFlag);             {   update edit cmds    }
  762.       for I := 3 to 6 do
  763.         SetItemState(EM,I,not AFlag);  
  764.       SetItemState(EM,8,AFlag);                 {   update Quit command }
  765.       for I := IM to DM do                      {   update other menus  }
  766.         SetItemState(I,0,AFlag);
  767.       DrawMenuBar                               {   update menu bar     }
  768.     end
  769.   end
  770. end; { of proc DoActivate }
  771.  
  772. procedure Initialize;
  773. {
  774.     purpose         initialize everything for the program
  775. }
  776. var
  777.   Indx                : Integer;
  778.   Result        : Real;
  779. begin
  780.   { initialize all the different managers                               }
  781.   InitGraf(@thePort);               { create a grafport for the screen  }
  782.   InitFonts;                        { start up the font manager         }
  783.   InitWindows;                      { start up the window manager       }
  784.   InitMenus;                        { start up the menu manager         }
  785.   TEInit;                           { start up the text manager for DAs }
  786.   InitDialogs(NIL);                 { start up the dialog manager       }
  787.   FlushEvents(everyEvent,0);        { clear events from previous state  }
  788.  
  789.   { get four standard system cursors, plus one custom one               }
  790.   for Indx := iBeamCursor to watchCursor do begin
  791.     CursList[Indx]:=GetCursor(Indx); { read in from system resource     }
  792.     HLock(Handle(CursList[Indx]))    { lock the handle down             }
  793.   end;
  794.   CursList[myCursor] := GetCursor(MyCursID); { get cursor from resources}
  795.   HLock(Handle(CursList[myCursor]));         { and lock it down         }
  796.   SetCursor(CursList[watchCursor]^^);{ bring up watch cursor            }
  797.   
  798.   { set up menus }
  799.   MenuList[AM] := GetMenu(ApplMenu);{ read menus in from resource fork  }
  800.   MenuList[EM] := GetMenu(EditMenu);
  801.   MenuList[IM] := GetMenu(InfoMenu);
  802.   MenuList[GM] := GetMenu(GrafMenu);
  803.   MenuList[DM] := GetMenu(DiskMenu);
  804.   AddResMenu(MenuList[AM],'DRVR');  { pull in all desk accessories      }
  805.   for Indx := 1 to MenuCnt do       { place menus in menu bar           }
  806.     InsertMenu(MenuList[Indx],0);
  807.   DrawMenuBar;                      { draw updated menu bar to screen   }
  808.  
  809.   { set up window stuff }
  810.   GetWMgrPort(ScreenPort);          { get grafport for all windows      }
  811.   SetPort(ScreenPort);              { and keep hand just in case        }
  812.   MainPtr := GetNewWindow(MainID,@MainRec,Pointer(-1));    { get window }
  813.   SetPort(MainPtr);                 { set window to current graf port   }
  814.   SelectWindow(MainPtr);            { and make window active            }
  815.   FrontWindow := MainPtr;           { remember that it's in front       }
  816.   DrawGrowIcon(MainPtr);            { draw the grow box in the corner   }
  817.   MainPeek := WindowPeek(MainPtr);  { get pointer to window record      }
  818.   MainPeek^.windowKind := UserKind; { set window type = user kind (ID=8)}
  819.   ScreenArea := screenBits.Bounds;  { get size of screen (don't assume) }
  820.   with ScreenArea do begin
  821.     SetRect(DragArea,5,38,Right-5,Bottom-10);   { set drag region       }
  822.     SetRect(GrowArea,50,20,Right-5,Bottom-10)   { set grow region       }
  823.   end;
  824.   
  825. { program-specific initialization }
  826.   VFlag := False;
  827.   FileSelected := False;            { set file opened false             }
  828.   New(SPtr);
  829.   New(VolParmBlock);
  830.   New(FileParmBLock);
  831.   VolParmBlock^.ioVRefNum := 0;
  832.   
  833.   UpdateMenu;                       { update menu as needed             }
  834.   Finished := False                 { set program terminator to false   }  
  835. end; { of proc Initialize }
  836.  
  837. procedure CleanUp;
  838. {
  839.     purpose         to do whatever's needed before returning to Finder
  840. }
  841. begin
  842.   DisposeWindow(MainPtr)            { get rid of the main window        }
  843. end; { of proc CleanUp }
  844.  
  845. procedure CursorAdjust;
  846. {
  847.     purpose         change cursors depending upon location
  848. }
  849. var
  850.   MousePt         : Point;
  851. begin
  852.   if MainPtr = FrontWindow then with MainPeek^ do begin
  853.     GetMouse(MousePt);                          {  find where mouse is  }
  854.     if PtInRect(MousePt,port.portRect) then     {  if over window then  }
  855.       if Button                                 {   if button down...   }
  856.         then SetCursor(CursList[plusCursor]^^)  {    then make a plus   }
  857.         else  SetCursor(CursList[crossCursor]^^){    else make a cross  }
  858.       else SetCursor(Arrow)                     {   else make an arrow  }
  859.   end
  860. end; { of proc CursorAdjust }
  861.  
  862. procedure HandleEvent(theEvent : EventRecord);
  863. {
  864.     purpose         decodes event and handles it
  865. }
  866. begin
  867.   case theEvent.What of
  868.     mouseDown        : DoMouseDown(theEvent);      { mouse button pushed   }
  869.     keyDown       : DoKeyPress(theEvent);       { key pressed down      }
  870.     autoKey       : DoKeyPress(theEvent);       { key held down         }
  871.     updateEvt     : DoUpdate(theEvent);         { window need updating  }
  872.     activateEvt   : DoActivate(theEvent)        { window made act/inact }
  873.   end
  874. end; { of proc HandleEvent }
  875.  
  876. begin { main body of program MyDemo }
  877.    Initialize;                              { set everything up         }
  878.    repeat                                   { keep doing the following  }              
  879.      SystemTask;                            { update desk accessories   }
  880.      CursorAdjust;                          { update which cursor       }
  881.      if GetNextEvent(everyEvent,theEvent)   {   if there's an event...  }
  882.        then HandleEvent(theEvent)           {     ...then handle it     }
  883.    until Finished;                          { until user is done        }
  884.    Cleanup                                  { clean everything up       }
  885. end. { of program MyDemo }
  886.